#!/usr/bin/runhugs
-- Calculates basic LCD monitor parameters from diagonals.
--
-- Copyright (c) bkil, 2009
-- License: GNU GPL v2 (or later), see the
--  attached gpl-2.0.txt for details.
--
--Changelog:
-- 2009.01.20 v0.0 first release
-- 2009.01.22 v0.1 refactoring: cleanup, typo in comments
-- 2009.01.29 v0.2 refactoring: friendlier names, Html type
-- 2009.02.04 v0.3 refactoring: tidied comments, improved formatting,
--            fixed a few names (CamelCase), used html more
-- 2010.04.07 v0.3.1 DPI, EEE, widescreens added
-- 2013.08.29 v0.3.2 HD added


--HTML substring type
newtype HtmlChar = HtmlChar Char
type Html = [HtmlChar]

instance Show HtmlChar where
         show (HtmlChar ch) = [ch]

showHtml :: Html -> String
showHtml = concat . map show

--does conversion with simple HTML escaping of main body text
toHtml :: String -> Html
toHtml = concat . map code  where
   code '&' = html "&amp;"
   code '<' = html "&lt;"
   code '>' = html "&gt;"
   code c   = html [c]

--constructor for constants (no conversion!)
html :: String -> Html
html = map HtmlChar

--similar to unlines
unlinesHtml :: [Html] -> Html
unlinesHtml s = concat . zipWith (++) s $ repeat $ html ['\n']


--the type of the data structure used by the parameter routine
data UnionParameter =
      ParamInt   Int       String | -- an Int  with a measure
      ParamFloat Float Int String | -- a Float with a measure
      ParamRatio Int Int            -- a ratio

instance Show UnionParameter where
         show (ParamInt   i        s) = show i ++ s
         show (ParamFloat x digits s) = showPrecision x digits ++ s
         show (ParamRatio a b)        = show a ++ ":" ++ show b


--an optional (ugly) routine for outputting in limited precision
showPrecision :: Float -> Int -> String
showPrecision x digits
 | digits == 0 = show $ myRound x
 | otherwise   = int ++ "." ++ frac  where
    (int,frac) = if shifted_x < shift   -- almost: x < 1
       then replacehd0 $ int_to_2str (shifted_x + shift)
       else              int_to_2str shifted_x
    shift     = 10 ^ digits
    shifted_x = myRound $ x * fromIntegral shift
    replacehd0 ([],b)    = ([],b)  -- never happens
    replacehd0 ((_:a),b) = (('0':a),b)
    int_to_2str y = splitAt (length sy - digits) sy  where
       sy = show y

--a helper for showPrecision
myRound :: Float -> Int
myRound = floor . (0.5+)


--the routine that calculates all the parameters
-- input: diagonal in inches, horizontal pixels, vertical pixels
--
getParams :: (Float, Int, Int) -> [UnionParameter]
getParams (diag_inch, xi, yi) =
 [ParamFloat diag_inch 1 "in",  ParamRatio a b,
  ParamInt   xi          "px",  ParamInt   yi        "px",
  ParamFloat dpi       0 "dpi", ParamFloat dotPitch 3 "mm",
  ParamFloat megaPix 2 "Mpx",
  ParamFloat area_cm  0 "cm^2",
  ParamFloat w        1 "mm",   ParamFloat h        1 "mm"
 ]  where
   a        = xi `div` gcd xi yi ;  b  = yi `div` gcd xi yi
   x        = fromIntegral xi    ;  y  = fromIntegral yi
   diag_mm  = diag_inch * inch_mm
   inch_mm  = 25.4
   aspect   = x/y
   calcDiag = sqrt $ aspect*aspect + 1*1
   scale    = diag_mm/calcDiag
   w        = scale*aspect       ;  h = scale*1
   area_cm  = w*h / 1e2
   megaPix  = x*y / 1e6
   dotPitch = w/x
   dpi      = x / (w/inch_mm)


--presentation alternative #1: list format in plain text
listTable :: Show a=> [[a]] -> String
listTable   = unlines . map (listSemi . map show)  where
   listSemi = foldl1 (\a b -> a ++ "; " ++ b)

--presentation alternative #2: HTML (uses toHtml, html, unlinesHtml)
-- (you could use concat instead of unlines to suppress line breaks)
htmlTable :: Show a=> [[a]] -> Html
htmlTable table = unlinesHtml lines  where
   lines = [html "<table>"] ++ rows table ++ [html "</table>"]
   rows  = map (\r-> html " <tr>" ++ (concat . cols)r ++ html "</tr>")
   cols  = map (\c-> html " <td>" ++ (toHtml . show)c ++ html "</td>")

--outputs a few parameters of common computer displays
main       = putStr result  where
   result  = ( showHtml $ htmlTable results ) ++ listTable results
   results = map getParams modes
   modes   = [
      (7,    800, 480),
      (13,   640, 480), (13, 800, 600),
      (15,  1024, 768),
      (15.6,1360, 768),
      (17,  1280,1024),
      (18.5,1360, 768),
      (19,  1440, 900), (19,1280,1024),
      (19.5,1600, 900),
      (20,  1600,1200),
      (22,  1680,1050), (21.5,1920,1080), (22,1600,1200),
      (23.6,1920,1080),
      (24,  1920,1200)
      ]
